home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Source Code / Visual Basic Source Code.iso / vbsource / iconal1a / iconbook.frm (.txt) < prev    next >
Encoding:
Visual Basic Form  |  1999-10-08  |  9.6 KB  |  290 lines
  1. VERSION 4.00
  2. Begin VB.Form IconBook 
  3.    AutoRedraw      =   -1  'True
  4.    BackColor       =   &H00C0C0C0&
  5.    Caption         =   "IconAlbum     1999 by Swertvaegher Stephan"
  6.    ClientHeight    =   7275
  7.    ClientLeft      =   975
  8.    ClientTop       =   1560
  9.    ClientWidth     =   10950
  10.    Height          =   7680
  11.    Icon            =   "IconBook.frx":0000
  12.    Left            =   915
  13.    LinkTopic       =   "Form1"
  14.    ScaleHeight     =   485
  15.    ScaleMode       =   3  'Pixel
  16.    ScaleWidth      =   730
  17.    Top             =   1215
  18.    Width           =   11070
  19.    Begin VB.Frame Frame1 
  20.       Caption         =   "Commands"
  21.       BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851} 
  22.          Name            =   "MS Sans Serif"
  23.          Size            =   12
  24.          Charset         =   0
  25.          Weight          =   700
  26.          Underline       =   0   'False
  27.          Italic          =   0   'False
  28.          Strikethrough   =   0   'False
  29.       EndProperty
  30.       ForeColor       =   &H00FF0000&
  31.       Height          =   1545
  32.       Left            =   90
  33.       TabIndex        =   4
  34.       Top             =   5670
  35.       Width           =   2265
  36.       Begin VB.CommandButton Command2 
  37.          Caption         =   "Search for Icons"
  38.          Height          =   330
  39.          Left            =   315
  40.          TabIndex        =   6
  41.          Top             =   990
  42.          Width           =   1635
  43.       End
  44.       Begin VB.CommandButton Command1 
  45.          Caption         =   "Make new directory"
  46.          Height          =   330
  47.          Left            =   315
  48.          TabIndex        =   5
  49.          Top             =   540
  50.          Width           =   1635
  51.       End
  52.    End
  53.    Begin VB.PictureBox Pic2 
  54.       AutoRedraw      =   -1  'True
  55.       BorderStyle     =   0  'None
  56.       Height          =   6765
  57.       Left            =   2430
  58.       ScaleHeight     =   6765
  59.       ScaleWidth      =   8385
  60.       TabIndex        =   2
  61.       Top             =   405
  62.       Width           =   8385
  63.       Begin VB.PictureBox Pic1 
  64.          AutoSize        =   -1  'True
  65.          BackColor       =   &H00E0E0E0&
  66.          BorderStyle     =   0  'None
  67.          Height          =   480
  68.          Index           =   0
  69.          Left            =   180
  70.          ScaleHeight     =   480
  71.          ScaleWidth      =   480
  72.          TabIndex        =   3
  73.          Top             =   180
  74.          Visible         =   0   'False
  75.          Width           =   480
  76.       End
  77.    End
  78.    Begin VB.DirListBox Dir1 
  79.       BackColor       =   &H00C0FFC0&
  80.       BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851} 
  81.          Name            =   "MS Sans Serif"
  82.          Size            =   8.25
  83.          Charset         =   0
  84.          Weight          =   700
  85.          Underline       =   0   'False
  86.          Italic          =   0   'False
  87.          Strikethrough   =   0   'False
  88.       EndProperty
  89.       ForeColor       =   &H008080FF&
  90.       Height          =   4980
  91.       Left            =   45
  92.       TabIndex        =   1
  93.       Top             =   45
  94.       Width           =   2310
  95.    End
  96.    Begin VB.FileListBox File1 
  97.       Height          =   3570
  98.       Left            =   2340
  99.       Pattern         =   "*.ico"
  100.       TabIndex        =   0
  101.       Top             =   2925
  102.       Visible         =   0   'False
  103.       Width           =   1590
  104.    End
  105.    Begin VB.Label Label2 
  106.       Alignment       =   2  'Center
  107.       BackColor       =   &H00C0FFC0&
  108.       BorderStyle     =   1  'Fixed Single
  109.       BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851} 
  110.          Name            =   "MS Sans Serif"
  111.          Size            =   9.75
  112.          Charset         =   0
  113.          Weight          =   700
  114.          Underline       =   0   'False
  115.          Italic          =   0   'False
  116.          Strikethrough   =   0   'False
  117.       EndProperty
  118.       ForeColor       =   &H000000FF&
  119.       Height          =   510
  120.       Left            =   45
  121.       TabIndex        =   8
  122.       Top             =   5085
  123.       Width           =   2310
  124.    End
  125.    Begin VB.Label Label1 
  126.       BackColor       =   &H00C0FFC0&
  127.       BorderStyle     =   1  'Fixed Single
  128.       BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851} 
  129.          Name            =   "MS Sans Serif"
  130.          Size            =   9.75
  131.          Charset         =   0
  132.          Weight          =   700
  133.          Underline       =   0   'False
  134.          Italic          =   0   'False
  135.          Strikethrough   =   0   'False
  136.       EndProperty
  137.       ForeColor       =   &H000000FF&
  138.       Height          =   330
  139.       Left            =   2430
  140.       TabIndex        =   7
  141.       Top             =   45
  142.       Width           =   8340
  143.    End
  144.    Begin MSComDlg.CommonDialog ComD1 
  145.       Left            =   10395
  146.       Top             =   0
  147.       _ExtentX        =   847
  148.       _ExtentY        =   847
  149.       _Version        =   393216
  150.       CancelError     =   -1  'True
  151.       DefaultExt      =   ".ico"
  152.       Flags           =   2
  153.    End
  154.    Begin VB.Menu mnuFile 
  155.       Caption         =   ""
  156.       Visible         =   0   'False
  157.       Begin VB.Menu mnuSaveAs 
  158.          Caption         =   "Save Icon As"
  159.       End
  160.       Begin VB.Menu mnuMove 
  161.          Caption         =   "Move Icon"
  162.       End
  163.       Begin VB.Menu mnuDelete 
  164.          Caption         =   "Delete Icon"
  165.       End
  166.    End
  167. Attribute VB_Name = "IconBook"
  168. Attribute VB_Creatable = False
  169. Attribute VB_Exposed = False
  170. Private Sub Command1_Click() 'Make new dir
  171. On Error GoTo mkdir0
  172. Temp$ = InputBox("Type the name of the new directory" & vbCr & "you want to create.", "IconAlbum")
  173. If Temp$ = "" Then Pic2.SetFocus: Exit Sub
  174. MkDir IBpath$ & "\" & Temp$
  175. Dir1.Refresh
  176. Pic2.SetFocus
  177. mkdir0:
  178. End Sub
  179. Private Sub Command2_Click()
  180. SearchForm.Show 1
  181. Pic2.SetFocus
  182. End Sub
  183. Private Sub Dir1_Change()
  184. Dir1.Path = IBpath
  185. End Sub
  186. Private Sub Dir1_Click()
  187. For xx% = 0 To 179
  188. Pic1(xx%).Picture = LoadPicture("")
  189. Pic1(xx%).Visible = False
  190. Next xx%
  191. File1.Path = Dir1.List(Dir1.ListIndex)
  192. If File1.ListCount <= 180 Then
  193. Idx% = File1.ListCount - 1
  194. Idx% = 179
  195. End If
  196. Label1.Caption = Dir1.List(Dir1.ListIndex)
  197. Label2.Caption = "Icons in map:" & vbCr & Idx% + 1
  198. For xx% = 0 To Idx%
  199. If Right(File1.Path, 1) = "\" Then
  200. Pic1(xx%).Picture = LoadPicture(File1.Path + File1.List(xx%))
  201. Pic1(xx%).Picture = LoadPicture(File1.Path + "\" + File1.List(xx%))
  202. End If
  203. Pic1(xx%).Visible = True
  204. Next xx%
  205. End Sub
  206. Private Sub Form_Activate()
  207. 'Pic2.SetFocus
  208. End Sub
  209. Private Sub Form_Load()
  210. Call ColForm(Pic2, 128, 148, 96, 50)
  211. IBpath = App.Path
  212. IconBook.Move (Screen.Width - IconBook.Width) / 2, (Screen.Height - IconBook.Height) / 2
  213. For xx = 1 To 179
  214. Load Pic1(xx%)
  215. Next xx
  216. For xx = 0 To 14
  217. Pic1(xx%).Left = Pic1(0).Left + (xx% * 36)
  218. Pic1(xx% + 15).Left = Pic1(0).Left + (xx% * 36)
  219. Pic1(xx% + 30).Left = Pic1(0).Left + (xx% * 36)
  220. Pic1(xx% + 45).Left = Pic1(0).Left + (xx% * 36)
  221. Pic1(xx% + 60).Left = Pic1(0).Left + (xx% * 36)
  222. Pic1(xx% + 75).Left = Pic1(0).Left + (xx% * 36)
  223. Pic1(xx% + 90).Left = Pic1(0).Left + (xx% * 36)
  224. Pic1(xx% + 105).Left = Pic1(0).Left + (xx% * 36)
  225. Pic1(xx% + 120).Left = Pic1(0).Left + (xx% * 36)
  226. Pic1(xx% + 135).Left = Pic1(0).Left + (xx% * 36)
  227. Pic1(xx% + 150).Left = Pic1(0).Left + (xx% * 36)
  228. Pic1(xx% + 165).Left = Pic1(0).Left + (xx% * 36)
  229. Pic1(xx%).Top = Pic1(0).Top
  230. Pic1(xx% + 15).Top = Pic1(0).Top + 36
  231. Pic1(xx% + 30).Top = Pic1(0).Top + 72
  232. Pic1(xx% + 45).Top = Pic1(0).Top + 108
  233. Pic1(xx% + 60).Top = Pic1(0).Top + 144
  234. Pic1(xx% + 75).Top = Pic1(0).Top + 180
  235. Pic1(xx% + 90).Top = Pic1(0).Top + 216
  236. Pic1(xx% + 105).Top = Pic1(0).Top + 252
  237. Pic1(xx% + 120).Top = Pic1(0).Top + 288
  238. Pic1(xx% + 135).Top = Pic1(0).Top + 324
  239. Pic1(xx% + 150).Top = Pic1(0).Top + 360
  240. Pic1(xx% + 165).Top = Pic1(0).Top + 396
  241. Next xx%
  242. Dir1.Path = IBpath
  243. End Sub
  244. Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
  245. End Sub
  246. Private Sub mnuDelete_Click()
  247. Temp$ = MsgBox("Are you sure you want to delete the icon: " & vbCr & vbCr & Dir1.List(Dir1.ListIndex) & "\" & File1.List(IconIdx%), vbQuestion + vbYesNo, "IconAlbum - System message")
  248. If Temp$ = vbNo Then Exit Sub
  249. Kill Dir1.List(Dir1.ListIndex) & "\" & File1.List(IconIdx%)
  250. File1.Refresh
  251. Dir1_Click
  252. End Sub
  253. Private Sub mnuMove_Click()
  254. Dim Oldpath$, Newpath$
  255. Oldpath$ = Dir1.List(Dir1.ListIndex)
  256. On Error GoTo mnuMove2
  257. inp$ = InputBox("You want to move the icon:" & vbCr & Dir1.List(Dir1.ListIndex) & "\" & File1.List(IconIdx%) & vbCr & vbCr & "Type the name of the destination map:", "IconAlbum", inp$)
  258. If inp$ = "" Then Exit Sub
  259. FileCopy Oldpath$ & "\" & File1.List(IconIdx%), IBpath & "\" & inp$ & "\" & File1.List(IconIdx%)
  260. Kill Oldpath & "\" & File1.List(IconIdx%)
  261. File1.Refresh
  262. Dir1_Click
  263. Exit Sub
  264. mnuMove2:
  265. If Err = 76 Then
  266. Temp$ = MsgBox("The map " & inp$ & " does not exist !" & vbCr & vbCr & "Do you want me to create it ?", vbExclamation + vbYesNo, "IconAlbum - System message")
  267. If Temp$ = vbNo Then Exit Sub
  268. MkDir IBpath & "\" & inp$
  269. Dir1.Refresh
  270. FileCopy Oldpath$ & "\" & File1.List(IconIdx%), IBpath & "\" & inp$ & "\" & File1.List(IconIdx%)
  271. Kill Oldpath$ & "\" & File1.List(IconIdx%)
  272. File1.Refresh
  273. Dir1_Click
  274. Exit Sub
  275. End If
  276. Mess$ = MsgBox("There's a copy error !", vbCritical + vbOKOnly, "IconAlbum - System Message")
  277. End Sub
  278. Private Sub mnuSaveAs_Click()
  279. On Error GoTo NoSave
  280. ComD1.filename = File1.List(IconIdx%)
  281. ComD1.DialogTitle = "Save Icon"
  282. ComD1.ShowSave
  283. SavePicture Pic1(IconIdx%).Picture, ComD1.filename
  284. NoSave:
  285. End Sub
  286. Private Sub Pic1_Click(Index As Integer)
  287. IconIdx% = Index
  288. PopupMenu mnuFile
  289. End Sub
  290.